Browse Source

use Htbl in anon identification to avoid a mutex

Simon Krajewski 3 months ago
parent
commit
dc08436255
3 changed files with 9 additions and 11 deletions
  1. 1 1
      src/generators/genjvm.ml
  2. 2 2
      src/generators/genshared.ml
  3. 6 8
      src/typing/tanon_identification.ml

+ 1 - 1
src/generators/genjvm.ml

@@ -3012,7 +3012,7 @@ let generate_anons gctx pool =
 		end;
 		end;
 		write_class gctx path (jc#export_class gctx.default_export_config)
 		write_class gctx path (jc#export_class gctx.default_export_config)
 	in
 	in
-	let seq = Hashtbl.to_seq gctx.anon_identification#get_pfms in
+	let seq = gctx.anon_identification#get_pfms in
 	Parallel.ParallelSeq.iter pool run seq
 	Parallel.ParallelSeq.iter pool run seq
 
 
 let generate_typed_functions gctx =
 let generate_typed_functions gctx =

+ 2 - 2
src/generators/genshared.ml

@@ -314,7 +314,7 @@ class ['a] typedef_interfaces (infos : 'a info_context) (anon_identification : '
 		let tc = TInst(c,extract_param_types c.cl_params) in
 		let tc = TInst(c,extract_param_types c.cl_params) in
 		(* TODO: this entire architecture looks slightly retarded because typedef_implements is only modified at the end of the
 		(* TODO: this entire architecture looks slightly retarded because typedef_implements is only modified at the end of the
 		   loop, which I think could cause items to be missed. *)
 		   loop, which I think could cause items to be missed. *)
-		let l = Hashtbl.fold (fun _ pfm acc ->
+		let l = Seq.fold_left (fun acc (_,pfm) ->
 			let path = pfm.pfm_path in
 			let path = pfm.pfm_path in
 			let path_inner = (fst path,snd path ^ "$Interface") in
 			let path_inner = (fst path,snd path ^ "$Interface") in
 			try
 			try
@@ -327,6 +327,6 @@ class ['a] typedef_interfaces (infos : 'a info_context) (anon_identification : '
 				(ci :: acc)
 				(ci :: acc)
 			with Unify_error _ ->
 			with Unify_error _ ->
 				acc
 				acc
-		) anon_identification#get_pfms [] in
+		) [] anon_identification#get_pfms in
 		info.typedef_implements <- Some l
 		info.typedef_implements <- Some l
 end
 end

+ 6 - 8
src/typing/tanon_identification.ml

@@ -1,5 +1,6 @@
 open Globals
 open Globals
 open Type
 open Type
+open Saturn
 
 
 let replace_mono tmono_as_tdynamic t =
 let replace_mono tmono_as_tdynamic t =
 	let visited_anons = ref [] in
 	let visited_anons = ref [] in
@@ -47,22 +48,19 @@ class ['a] tanon_identification =
 	in
 	in
 object(self)
 object(self)
 
 
-	val pfms = Hashtbl.create 0
+	val pfms = Htbl.create ()
 	val pfm_mutex = Mutex.create ()
 	val pfm_mutex = Mutex.create ()
 	val pfm_by_arity = DynArray.create ()
 	val pfm_by_arity = DynArray.create ()
-	val add_pfm_mutex = Mutex.create ()
 	val mutable num = 0
 	val mutable num = 0
 
 
-	method get_pfms = pfms
+	method get_pfms = Htbl.to_seq pfms
 
 
 	method add_pfm (path : path) (pfm : 'a path_field_mapping) =
 	method add_pfm (path : path) (pfm : 'a path_field_mapping) =
-		Mutex.lock add_pfm_mutex;
 		while DynArray.length pfm_by_arity <= pfm.pfm_arity do
 		while DynArray.length pfm_by_arity <= pfm.pfm_arity do
 			DynArray.add pfm_by_arity (DynArray.create ())
 			DynArray.add pfm_by_arity (DynArray.create ())
 		done;
 		done;
 		DynArray.add (DynArray.get pfm_by_arity pfm.pfm_arity) pfm;
 		DynArray.add (DynArray.get pfm_by_arity pfm.pfm_arity) pfm;
-		Hashtbl.replace pfms path pfm;
-		Mutex.unlock add_pfm_mutex
+		ignore(Htbl.try_add pfms path pfm)
 
 
 	method unify ~(strict:bool) (tc : Type.t) (pfm : 'a path_field_mapping) =
 	method unify ~(strict:bool) (tc : Type.t) (pfm : 'a path_field_mapping) =
 		let uctx = if strict then {
 		let uctx = if strict then {
@@ -169,7 +167,7 @@ object(self)
 		match !(an.a_status) with
 		match !(an.a_status) with
 		| ClassStatics {cl_path = path} | EnumStatics {e_path = path} | AbstractStatics {a_path = path} ->
 		| ClassStatics {cl_path = path} | EnumStatics {e_path = path} | AbstractStatics {a_path = path} ->
 			Mutex.protect pfm_mutex (fun () -> try
 			Mutex.protect pfm_mutex (fun () -> try
-				Hashtbl.find pfms path
+				Htbl.find_exn pfms path
 			with Not_found ->
 			with Not_found ->
 				let pfm = make_pfm path in
 				let pfm = make_pfm path in
 				self#add_pfm path pfm;
 				self#add_pfm path pfm;
@@ -203,7 +201,7 @@ object(self)
 		match t with
 		match t with
 		| TType(td,tl) ->
 		| TType(td,tl) ->
 			begin try
 			begin try
-				Some (Mutex.protect pfm_mutex (fun () -> Hashtbl.find pfms td.t_path))
+				Some (Mutex.protect pfm_mutex (fun () -> Htbl.find_exn pfms td.t_path))
 			with Not_found ->
 			with Not_found ->
 				self#identify accept_anons (apply_typedef td tl)
 				self#identify accept_anons (apply_typedef td tl)
 			end
 			end