[cs] Transform cs.Pointer into abstract; Allow capturing pointers and using pointers in parameters

gencommon.ml

@@ -70,15 +70,26 @@ let rec like_float t =
 	match follow t with
 		| TAbstract({ a_path = ([], "Float") },[])
 		| TAbstract({ a_path = ([], "Int") },[]) -> true
+		| TAbstract({ a_path = (["cs"], "Pointer") },_) -> false
 		| TAbstract(a, _) -> List.exists (fun t -> like_float t) a.a_from || List.exists (fun t -> like_float t) a.a_to
 		| _ -> false
 
 let rec like_int t =
 	match follow t with
 		| TAbstract({ a_path = ([], "Int") },[]) -> true
+		| TAbstract({ a_path = (["cs"], "Pointer") },_) -> false
 		| TAbstract(a, _) -> List.exists (fun t -> like_int t) a.a_from || List.exists (fun t -> like_int t) a.a_to
 		| _ -> false
 
+let rec like_i64 t =
+	match follow t with
+		| TInst({ cl_path = (["cs"], "Int64") },[])
+		| TInst({ cl_path = (["cs"], "UInt64") },[])
+		| TInst({ cl_path = (["java"], "Int64") },[])
+		| TInst({ cl_path = (["haxe"], "Int64") },[])
+		| TAbstract({ a_path = (["haxe"], "Int64") },[]) -> true
+		| TAbstract(a, _) -> List.exists (fun t -> like_i64 t) a.a_from || List.exists (fun t -> like_i64 t) a.a_to
+		| _ -> false
 
 let follow_once t =
 	match t with
@@ -240,6 +251,8 @@ let path_s path =
 
 let get_cl mt = match mt with | TClassDecl cl -> cl | _ -> failwith ("Unexpected module type of '" ^ path_s (t_path mt) ^ "'")
 
+let get_abstract mt = match mt with | TAbstractDecl a -> a | _ -> failwith ("Unexpected module type of '" ^ path_s (t_path mt) ^ "'")
+
 let get_tdef mt = match mt with | TTypeDecl t -> t | _ -> assert false
 
 let mk_mt_access mt pos = { eexpr = TTypeExpr(mt); etype = anon_of_mt mt; epos = pos }
@@ -3400,7 +3413,7 @@ struct
 			let rettype_real_to_func t = match run_follow gen t with
 				| TType({ t_path = [],"Null" }, _) ->
 					0,t_dynamic
-				| _ when like_float t ->
+				| _ when like_float t && not (like_i64 t) ->
 					(1, basic.tfloat)
 				| _ ->
 					(0, t_dynamic)
@@ -3411,10 +3424,10 @@ struct
 					[{ eexpr = TArrayDecl el; etype = basic.tarray t_dynamic; epos = pos }]
 				else begin
 					List.fold_left (fun acc e ->
-																						if like_float (gen.greal_type e.etype) then
-																							( e :: undefined e.epos :: acc )
-																						else
-																							( null basic.tfloat e.epos :: e :: acc )
+						if like_float (gen.greal_type e.etype) && not (like_i64 (gen.greal_type e.etype)) then
+							( e :: undefined e.epos :: acc )
+						else
+							( null basic.tfloat e.epos :: e :: acc )
 					) ([]) (List.rev el)
 				end
 			in
@@ -3560,8 +3573,9 @@ struct
 					| TCall(tc, params) -> (tc, params)
 					| _ -> assert false
 				in
+					let ct = gen.greal_type call_expr.etype in
 					let postfix, ret_t =
-						if like_float (gen.greal_type call_expr.etype) then
+						if like_float ct && not (like_i64 ct) then
 								"_f", gen.gcon.basic.tfloat
 						else
 							"_o", t_dynamic
@@ -3631,7 +3645,7 @@ struct
 						let vf, _ = List.nth args (i * 2) in
 						let vo, _ = List.nth args (i * 2 + 1) in
 
-						let needs_cast, is_float = match t, like_float t with
+						let needs_cast, is_float = match t, like_float t && not (like_i64 t) with
 							| TInst({ cl_path = ([], "Float") }, []), _
 							| TAbstract({ a_path = ([], "Float") },[]), _ -> false, true
 							| _, true -> true, true
@@ -3888,7 +3902,7 @@ struct
 				in
 				(* let rec loop goes here *)
 				let map_fn cur_arity fun_ret_type vars (api:(int->t->tconstant option->texpr)) =
-					let is_float = like_float fun_ret_type in
+					let is_float = like_float fun_ret_type && not (like_i64 fun_ret_type) in
 					match cur_arity with
 						| -1 ->
 							let dynargs = api (-1) (t_dynamic) None in
@@ -7113,7 +7127,7 @@ struct
 						| TInst ( { cl_path = ["haxe"], "Int64" }, [] ) ->
 							loop tl ((name, gen.ghandle_cast t_dynamic real_t expr) :: acc) acc_f
 						| _ ->
-							if like_float real_t then
+							if like_float real_t && not (like_i64 real_t) then
 								loop tl acc ((name, gen.ghandle_cast basic.tfloat real_t expr) :: acc_f)
 							else
 								loop tl ((name, gen.ghandle_cast t_dynamic real_t expr) :: acc) acc_f
@@ -7628,7 +7642,7 @@ struct
 						match follow (ctx.rcf_gen.greal_type (ctx.rcf_gen.gfollow#run_f cf.cf_type)) with
 							| TDynamic _ | TMono _
 							| TInst ({ cl_kind = KTypeParameter _ }, _) -> true
-							| t when like_float t -> true
+							| t when like_float t && not (like_i64 t) -> true
 							| _ -> false
 					) ret
 				else

gencs.ml

@@ -46,6 +46,8 @@ let rec is_cs_basic_type t =
 		| TEnum( { e_path = ([], "Bool") }, [] )
 		| TAbstract ({ a_path = ([], "Bool") },[]) ->
 			true
+		| TAbstract ({ a_path = (["cs"], "Pointer") },_) ->
+			false
 		| TAbstract _ when like_float t ->
 			true
 		| TAbstract(a,pl) when not (Meta.has Meta.CoreType a.a_meta) ->
@@ -109,13 +111,12 @@ let is_tparam t =
 let rec is_int_float t =
 	match follow t with
 		| TInst( { cl_path = (["haxe"], "Int32") }, [] )
-		| TInst( { cl_path = (["haxe"], "Int64") }, [] )
 		| TInst( { cl_path = ([], "Int") }, [] )
 		| TAbstract ({ a_path = ([], "Int") },[])
 		| TInst( { cl_path = ([], "Float") }, [] )
 		| TAbstract ({ a_path = ([], "Float") },[]) ->
 			true
-		| TAbstract _ when like_float t ->
+		| TAbstract _ when like_float t && not (like_i64 t) ->
 			true
 		| TInst( { cl_path = (["haxe"; "lang"], "Null") }, [t] ) -> is_int_float t
 		| _ -> false
@@ -134,6 +135,7 @@ let is_dynamic gen t =
 
 let is_pointer gen t =
 	match follow (gen.greal_type t) with
+		| TAbstract( ( {a_path = ["cs"], "Pointer"}, _ ) )
 		| TInst( {cl_path = ["cs"], "Pointer"}, _ ) -> true
 		| _ -> false
 
@@ -405,12 +407,13 @@ struct
 		let string_ext = get_cl ( get_type gen (["haxe";"lang"], "StringExt")) in
 		let is_string t = match follow t with | TInst({ cl_path = ([], "String") }, []) -> true | _ -> false in
 		let clstring = match basic.tstring with | TInst(cl,_) -> cl | _ -> assert false in
-		let boxed_ptr, clptr =
+		let ti64 = match ( get_type gen (["cs"], "Int64") ) with | TTypeDecl t -> TType(t,[]) | TAbstractDecl a -> TAbstract(a,[]) | _ -> assert false in
+		let boxed_ptr =
 			if Common.defined gen.gcon Define.Unsafe then
-				get_cl (get_type gen (["haxe";"lang"], "BoxedPointer")),
-				get_cl (get_type gen (["cs"],"Pointer"))
+				get_cl (get_type gen (["haxe";"lang"], "BoxedPointer"))
+				(* get_abstract (get_type gen (["cs"],"Pointer")) *)
 			else
-				null_class,null_class
+				null_class
 		in
 
 		let is_struct t = (* not basic type *)
@@ -458,6 +461,9 @@ struct
 					run ef
 				| TNew( { cl_path = ([], "String") }, [], [p] ) -> run p (* new String(myString) -> myString *)
 
+				| TCast(expr, _) when like_float expr.etype && is_pointer gen e.etype ->
+					let expr = run expr in
+					mk_cast e.etype (mk_cast ti64 expr)
 				| TCast(expr, _) when is_dynamic gen expr.etype && is_pointer gen e.etype ->
 					(match get_arrptr expr with
 						| None ->
@@ -2331,6 +2337,7 @@ let configure gen =
 	Hashtbl.add gen.gsupported_conversions (["haxe"; "lang"], "Null") (fun t1 t2 -> true);
 	let last_needs_box = gen.gneeds_box in
 	gen.gneeds_box <- (fun t -> match (gen.greal_type t) with
+		| TAbstract( ( { a_path = ["cs"], "Pointer" }, _ ) )
 		| TInst( { cl_path = ["cs"], "Pointer" }, _ )
 		| TInst( { cl_path = (["haxe"; "lang"], "Null") }, _ ) -> true
 		| _ -> last_needs_box t);

std/cs/Pointer.hx

@@ -20,6 +20,7 @@
  * DEALINGS IN THE SOFTWARE.
  */
 package cs;
+import cs.StdTypes.Int64;
 
 /**
 	This type represents pointer types for C# function parameters. It should only
@@ -42,12 +43,54 @@ package cs;
 #if !unsafe
 #error "You need to define 'unsafe' to be able to use unsafe code in hxcs"
 #else
-extern class Pointer<T> /*extends Int,*/ implements ArrayAccess<T>
+@:runtimeValue @:coreType abstract Pointer<T> from Int64
 {
-	static function op_Addition<T>(p:Pointer<T>, i:Int):Pointer<T>;
-	public inline function add(i:Int):Pointer<T>
+	@:op(A+B) public static function addIp<T>(lhs:Pointer<T>, rhs:Int):Pointer<T>;
+	@:op(A+B) public static function addp<T>(lhs:Pointer<T>, rhs:Int64):Pointer<T>;
+	@:op(A*B) public static function mulIp<T>(lhs:Pointer<T>, rhs:Int):Pointer<T>;
+	@:op(A*B) public static function mulp<T>(lhs:Pointer<T>, rhs:Int64):Pointer<T>;
+	@:op(A%B) public static function modIp<T>(lhs:Pointer<T>, rhs:Int):Pointer<T>;
+	@:op(A%B) public static function modp<T>(lhs:Pointer<T>, rhs:Int64):Pointer<T>;
+	@:op(A-B) public static function subIp<T>(lhs:Pointer<T>, rhs:Int):Pointer<T>;
+	@:op(A-B) public static function subp<T>(lhs:Pointer<T>, rhs:Int64):Pointer<T>;
+	@:op(A/B) public static function divIp<T>(lhs:Pointer<T>, rhs:Int):Pointer<T>;
+	@:op(A/B) public static function divp<T>(lhs:Pointer<T>, rhs:Int64):Pointer<T>;
+	@:op(A|B) public static function orIp<T>(lhs:Pointer<T>, rhs:Int):Pointer<T>;
+	@:op(A|B) public static function orp<T>(lhs:Pointer<T>, rhs:Int64):Pointer<T>;
+	@:op(A^B) public static function xorIp<T>(lhs:Pointer<T>, rhs:Int):Pointer<T>;
+	@:op(A^B) public static function xorp<T>(lhs:Pointer<T>, rhs:Int64):Pointer<T>;
+	@:op(A&B) public static function andIp<T>(lhs:Pointer<T>, rhs:Int):Pointer<T>;
+	@:op(A&B) public static function andp<T>(lhs:Pointer<T>, rhs:Int64):Pointer<T>;
+	@:op(A<<B) public static function shlIp<T>(lhs:Pointer<T>, rhs:Int):Pointer<T>;
+	@:op(A<<B) public static function shlp<T>(lhs:Pointer<T>, rhs:Int64):Pointer<T>;
+	@:op(A>>B) public static function shrIp<T>(lhs:Pointer<T>, rhs:Int):Pointer<T>;
+	@:op(A>>B) public static function shrp<T>(lhs:Pointer<T>, rhs:Int64):Pointer<T>;
+
+	@:op(A>B) public static function gtp<T>(lhs:Pointer<T>, rhs:Pointer<T>):Bool;
+	@:op(A>=B) public static function gtep<T>(lhs:Pointer<T>, rhs:Pointer<T>):Bool;
+	@:op(A<B) public static function ltp<T>(lhs:Pointer<T>, rhs:Pointer<T>):Bool;
+	@:op(A<=B) public static function ltep<T>(lhs:Pointer<T>, rhs:Pointer<T>):Bool;
+
+	@:op(~A) public static function bnegp<T>(t:Pointer<T>):Pointer<T>;
+
+	// backwards compatibility
+	inline public function add(i:Int):Pointer<T>
 	{
-		return op_Addition(this,i);
+		return this + i;
 	}
+
+	@:arrayAccess public static function getIp<T>(p:Pointer<T>, at:Int):T;
+	@:arrayAccess public static function setIp<T>(p:Pointer<T>, at:Int, val:T):T;
+	@:arrayAccess public static function getp<T>(p:Pointer<T>, at:Int64):T;
+	@:arrayAccess public static function setp<T>(p:Pointer<T>, at:Int64, val:T):T;
 }
+//
+// @:native('cs.Pointer') extern class PointerData<T> /*extends Int,*/ implements ArrayAccess<T>
+// {
+// 	static function op_Addition<T>(p:Pointer<T>, i:Int):Pointer<T>;
+// 	public inline function add(i:Int):Pointer<T>
+// 	{
+// 		return op_Addition(this,i);
+// 	}
+// }
 #end

tests/unit/TestCSharp.hx

@@ -47,6 +47,22 @@ class TestCSharp extends Test
 		eq(ptr[0],0xFFFF);
 		eq(captured[0],0xFFFF);
 		t(ptr == captured);
+
+		var other:Pointer<Pointer<Int>> = cast cs.system.runtime.interopservices.Marshal.AllocHGlobal(10 * 4).ToPointer();
+		other[0] = ptr;
+		eq(other[0][0], 0xFFFF);
+		var captured = other;
+		function test(v:Int) captured[0][0] = v;
+		test(-1);
+		eq(other[0][0],-1);
+		eq(captured[0][0],-1);
+		t(other == captured);
+
+		function test2(p:Pointer<Pointer<Int>>, v:Int)
+			p[0][0]=v;
+
+		test2(other,-2);
+		eq(other[0][0],-2);
 	}
 #end