[eval] add native Int64Map implementation

Author: Apprentice-Alchemist

src/core/globals.ml

@@ -19,6 +19,15 @@ module IntHashtbl = Hashtbl.Make(struct
 	let hash = Int.hash
 end)
 
+module Int64Hashtbl = Hashtbl.Make(struct
+	type t = Signed.Int64.t
+
+	let equal =
+		Signed.Int64.equal
+
+	let hash = Hashtbl.hash
+end)
+
 module StringHashtbl = Hashtbl.Make(struct
 	type t = string
 

src/macro/eval/evalEncode.ml

@@ -242,6 +242,9 @@ let encode_bytes =
 let encode_int_map_direct =
 	create_cached_instance key_haxe_ds_IntMap (fun s -> IIntMap s)
 
+let encode_int64_map_direct =
+	create_cached_instance key_haxe_ds_Int64Map (fun s -> IInt64Map s)
+
 let encode_string_map_direct =
 	create_cached_instance key_haxe_ds_StringMap (fun s -> IStringMap s)
 

src/macro/eval/evalHash.ml

@@ -56,6 +56,7 @@ let key_haxe_Exception = hash "haxe.Exception"
 let key_haxe_ds_Option = hash "haxe.ds.Option"
 let key_haxe_ds_StringMap = hash "haxe.ds.StringMap"
 let key_haxe_ds_IntMap = hash "haxe.ds.IntMap"
+let key_haxe_ds_Int64Map = hash "haxe.ds.Int64Map"
 let key_haxe_ds_ObjectMap = hash "haxe.ds.ObjectMap"
 let key_haxe_macro_Position = hash "haxe.macro.Position"
 let key_haxe_macro_LazyType = hash "haxe.macro.LazyType"

src/macro/eval/evalIntegers.ml

@@ -18,6 +18,14 @@ let encode_haxe_i64 low high =
 	set_instance_field vi key_low (vint32 low);
 	vinstance vi
 
+let encode_haxe_i64_int64 value =
+	let high = Stdlib.Int64.to_int32 (Stdlib.Int64.shift_right_logical value 32) in
+	let low = Stdlib.Int64.to_int32 value in
+	let vi = create_instance key_haxe__Int64____Int64 in
+	set_instance_field vi key_high (vint32 high);
+	set_instance_field vi key_low (vint32 low);
+	vinstance vi
+
 let encode_haxe_i64_direct i64 =
 	let low = GInt64.to_int32 i64 in
 	let high = GInt64.to_int32 (GInt64.shift_right_logical i64 32) in

src/macro/eval/evalMain.ml

@@ -295,6 +295,16 @@ let value_signature v =
 				) map;
 				addc 'h'
 			)
+		| VInstance {ikind = IInt64Map map} ->
+			cache v (fun () ->
+				addc 'Q';
+				RuntimeInt64Hashtbl.iter (fun i value ->
+					addc ':';
+					add (Int64.to_string i);
+					loop value
+				) map;
+				addc 'h'
+			)
 		| VInstance {ikind = IObjectMap map} ->
 			cache v (fun() ->
 				addc 'M';
@@ -495,6 +505,12 @@ let rec value_to_expr v p =
 			(make_map_entry e_key v) :: acc
 		) m [] in
 		(EArrayDecl el,p)
+	| VInstance {ikind = IInt64Map m} ->
+		let el = RuntimeInt64Hashtbl.fold (fun k v acc ->
+			let e_key = (EConst (Int (Int64.to_string k, Some "i64")),p) in
+			(make_map_entry e_key v) :: acc
+		) m [] in
+		(EArrayDecl el,p)
 	| VInstance {ikind = IStringMap m} ->
 		let el = RuntimeStringHashtbl.fold (fun k (_,v) acc ->
 			let e_key = (EConst (String(k,SDoubleQuotes)),p) in

src/macro/eval/evalStdLib.ml

@@ -1570,6 +1570,70 @@ module StdIntMap = struct
 	)
 end
 
+module StdInt64Map = struct
+	let this vthis = match vthis with
+		| VInstance {ikind = IInt64Map h} -> h
+		| v -> unexpected_value v "int64 map"
+
+	let copy = vifun0 (fun vthis ->
+		let copied = RuntimeInt64Hashtbl.copy (this vthis) in
+		encode_int64_map_direct copied
+	)
+
+	let exists = vifun1 (fun vthis vkey ->
+		vbool (RuntimeInt64Hashtbl.mem (this vthis) (EvalIntegers.decode_haxe_i64 vkey))
+	)
+
+	let get = vifun1 (fun vthis vkey ->
+		try RuntimeInt64Hashtbl.find (this vthis) (EvalIntegers.decode_haxe_i64 vkey)
+		with Not_found -> vnull
+	)
+
+	let iterator = vifun0 (fun vthis ->
+		let keys = RuntimeInt64Hashtbl.fold (fun _ v acc -> v :: acc) (this vthis) [] in
+		encode_list_iterator keys
+	)
+
+	let keys = vifun0 (fun vthis ->
+		let keys = RuntimeInt64Hashtbl.fold (fun k _ acc -> EvalIntegers.encode_haxe_i64_int64 k :: acc) (this vthis) [] in
+		encode_list_iterator keys
+	)
+
+	let keyValueIterator = map_key_value_iterator key_haxe_iterators_map_key_value_iterator
+
+	let remove = vifun1 (fun vthis vkey ->
+		let this = this vthis in
+		let key = EvalIntegers.decode_haxe_i64 vkey in
+		let b = RuntimeInt64Hashtbl.mem this key in
+		RuntimeInt64Hashtbl.remove this key;
+		vbool b
+	)
+
+	let set = vifun2 (fun vthis vkey vvalue ->
+		RuntimeInt64Hashtbl.add (this vthis) (EvalIntegers.decode_haxe_i64 vkey) vvalue;
+		vnull
+	)
+
+	let toString = vifun0 (fun vthis ->
+		let this = this vthis in
+		let l = RuntimeInt64Hashtbl.fold (fun key vvalue acc ->
+			(join empty_string [create_ascii (Int64.to_string key); create_ascii " => "; s_value 0 vvalue]) :: acc) this [] in
+		let s = join rcomma l in
+		let s = join empty_string [rbkopen;s;rbkclose] in
+		vstring s
+	)
+
+	let clear = vifun0 (fun vthis ->
+		RuntimeInt64Hashtbl.clear (this vthis);
+		vnull
+	)
+
+	let size = vifun0 (fun vthis ->
+		vint (RuntimeInt64Hashtbl.size (this vthis))
+	)
+end
+
+
 module StdStringMap = struct
 	let this vthis = match vthis with
 		| VInstance {ikind = IStringMap h} -> h
@@ -3229,6 +3293,19 @@ let init_maps builtins =
 		"clear",StdIntMap.clear;
 		"size",StdIntMap.size;
 	];
+	init_fields builtins (["haxe";"ds"],"Int64Map") [] [
+		"copy",StdInt64Map.copy;
+		"exists",StdInt64Map.exists;
+		"get",StdInt64Map.get;
+		"iterator",StdInt64Map.iterator;
+		"keys",StdInt64Map.keys;
+		"keyValueIterator",StdInt64Map.keyValueIterator;
+		"remove",StdInt64Map.remove;
+		"set",StdInt64Map.set;
+		"toString",StdInt64Map.toString;
+		"clear",StdInt64Map.clear;
+		"size",StdInt64Map.size;
+	];
 	init_fields builtins (["haxe";"ds"],"ObjectMap") [] [
 		"copy",StdObjectMap.copy;
 		"exists",StdObjectMap.exists;
@@ -3296,6 +3373,7 @@ let init_constructors builtins =
 		);
 	add key_haxe_ds_StringMap (fun _ -> encode_string_map_direct (RuntimeStringHashtbl.create ()));
 	add key_haxe_ds_IntMap (fun _ -> encode_int_map_direct (RuntimeIntHashtbl.create ()));
+	add key_haxe_ds_Int64Map (fun _ -> encode_int64_map_direct (RuntimeInt64Hashtbl.create ()));
 	add key_haxe_ds_ObjectMap (fun _ -> encode_object_map_direct (Obj.magic (ValueHashtbl.create 0)));
 	add key_haxe_io_BytesBuffer (fun _ -> encode_instance key_haxe_io_BytesBuffer ~kind:(IOutput (Buffer.create 0)));
 	add key_haxe_io_Bytes
@@ -3387,6 +3465,7 @@ let init_empty_constructors builtins =
 	IntHashtbl.add h key_String (fun () -> v_empty_string);
 	IntHashtbl.add h key_haxe_ds_StringMap (fun () -> encode_instance key_haxe_ds_StringMap ~kind:(IStringMap (RuntimeStringHashtbl.create ())));
 	IntHashtbl.add h key_haxe_ds_IntMap (fun () -> encode_instance key_haxe_ds_IntMap ~kind:(IIntMap (RuntimeIntHashtbl.create ())));
+	IntHashtbl.add h key_haxe_ds_Int64Map (fun () -> encode_instance key_haxe_ds_Int64Map ~kind:(IInt64Map (RuntimeInt64Hashtbl.create ())));
 	IntHashtbl.add h key_haxe_ds_ObjectMap (fun () -> encode_instance key_haxe_ds_ObjectMap ~kind:(IObjectMap (Obj.magic (ValueHashtbl.create 0))));
 	IntHashtbl.add h key_haxe_io_BytesBuffer (fun () -> encode_instance key_haxe_io_BytesBuffer ~kind:(IOutput (Buffer.create 0)))
 

src/macro/eval/evalValue.ml

@@ -75,6 +75,22 @@ module RuntimeIntHashtbl = struct
 	let size this = IntHashtbl.length this
 end
 
+module RuntimeInt64Hashtbl = struct
+	type 'value t = 'value Int64Hashtbl.t
+
+	let add this key v = Int64Hashtbl.replace this key v
+	let copy this = Int64Hashtbl.copy this
+	let create () = Int64Hashtbl.create 0
+	let find this key = Int64Hashtbl.find this key
+	let fold f this acc = Int64Hashtbl.fold f this acc
+	let is_empty this = Int64Hashtbl.length this = 0
+	let iter f this = Int64Hashtbl.iter f this
+	let mem this key = Int64Hashtbl.mem this key
+	let remove this key = Int64Hashtbl.remove this key
+	let clear this = Int64Hashtbl.clear this
+	let size this = Int64Hashtbl.length this
+end
+
 type vregex = {
 	r : Pcre2.regexp;
 	r_rex_string : vstring;
@@ -190,6 +206,7 @@ and vinstance_kind =
 	| IDate of float
 	| IStringMap of value RuntimeStringHashtbl.t
 	| IIntMap of value RuntimeIntHashtbl.t
+	| IInt64Map of value RuntimeInt64Hashtbl.t
 	| IObjectMap of (value,value) Hashtbl.t
 	| IOutput of Buffer.t (* BytesBuffer *)
 	| IBuffer of vstring_buffer(* StringBuf *)