Browse Source

Bucket typer delays (#11465)

* [typer] bucket delay lists by typer pass

* track minimum index to avoid some loopings
Simon Krajewski 1 year ago
parent
commit
3af71d0d80
2 changed files with 42 additions and 45 deletions
  1. 40 44
      src/context/typecore.ml
  2. 2 1
      src/typing/typerEntry.ml

+ 40 - 44
src/context/typecore.ml

@@ -60,6 +60,12 @@ type typer_pass =
 	| PForce				(* usually ensure that lazy have been evaluated *)
 	| PFinal				(* not used, only mark for finalize *)
 
+let all_typer_passes = [
+	PBuildModule;PBuildClass;PConnectField;PTypeField;PCheckConstraint;PForce;PFinal
+]
+
+let all_typer_passes_length = List.length all_typer_passes
+
 type typer_module = {
 	curmod : module_def;
 	import_resolution : resolution_list;
@@ -69,11 +75,6 @@ type typer_module = {
 	mutable import_statements : import list;
 }
 
-type delay = {
-	delay_pass : typer_pass;
-	delay_functions : (unit -> unit) list;
-}
-
 type build_kind =
 	| BuildNormal
 	| BuildGeneric of tclass
@@ -93,8 +94,13 @@ type macro_result =
 	| MError
 	| MMacroInMacro
 
+type typer_pass_tasks = {
+	mutable tasks : (unit -> unit) list;
+}
+
 type typer_globals = {
-	mutable delayed : delay list;
+	mutable delayed : typer_pass_tasks Array.t;
+	mutable delayed_min_index : int;
 	mutable debug_delayed : (typer_pass * ((unit -> unit) * (string * string list) * typer) list) list;
 	doinline : bool;
 	retain_meta : bool;
@@ -395,36 +401,19 @@ let is_gen_local v = match v.v_kind with
 	| _ ->
 		false
 
-let make_delay pass fl = {
-	delay_pass = pass;
-	delay_functions = fl;
-}
-
 let delay ctx p f =
-	let rec loop = function
-		| [] ->
-			[make_delay p [f]]
-		| delay :: rest ->
-			if delay.delay_pass = p then
-				(make_delay p (f :: delay.delay_functions)) :: rest
-			else if delay.delay_pass < p then
-				delay :: loop rest
-			else
-				(make_delay p [f]) :: delay :: rest
-	in
-	ctx.g.delayed <- loop ctx.g.delayed
+	let p = Obj.magic p in
+	let tasks = ctx.g.delayed.(p) in
+	tasks.tasks <- f :: tasks.tasks;
+	if p < ctx.g.delayed_min_index then
+		ctx.g.delayed_min_index <- p
 
 let delay_late ctx p f =
-	let rec loop = function
-		| [] ->
-			[make_delay p [f]]
-		| delay :: rest ->
-			if delay.delay_pass <= p then
-				delay :: loop rest
-			else
-				(make_delay p [f]) :: delay :: rest
-	in
-	ctx.g.delayed <- loop ctx.g.delayed
+	let p = Obj.magic p in
+	let tasks = ctx.g.delayed.(p) in
+	tasks.tasks <- tasks.tasks @ [f];
+	if p < ctx.g.delayed_min_index then
+		ctx.g.delayed_min_index <- p
 
 let delay_if_mono ctx p t f = match follow t with
 	| TMono _ ->
@@ -433,17 +422,24 @@ let delay_if_mono ctx p t f = match follow t with
 		f()
 
 let rec flush_pass ctx p where =
-	match ctx.g.delayed with
-	| delay :: rest when delay.delay_pass <= p ->
-		(match delay.delay_functions with
-		| [] ->
-			ctx.g.delayed <- rest;
-		| f :: l ->
-			ctx.g.delayed <- (make_delay delay.delay_pass l) :: rest;
-			f());
-		flush_pass ctx p where
-	| _ ->
-		()
+	let rec loop i =
+		if i > (Obj.magic p) then
+			()
+		else begin
+			let tasks = ctx.g.delayed.(i) in
+			match tasks.tasks with
+			| f :: l ->
+				tasks.tasks <- l;
+				f();
+				flush_pass ctx p where
+			| [] ->
+				(* Done with this pass (for now), update min index to next one *)
+				let i = i + 1 in
+				ctx.g.delayed_min_index <- i;
+				loop i
+		end
+	in
+	loop ctx.g.delayed_min_index
 
 let make_pass ctx f = f
 

+ 2 - 1
src/typing/typerEntry.ml

@@ -15,7 +15,8 @@ let create com macros =
 			macros = macros;
 			type_patches = Hashtbl.create 0;
 			module_check_policies = [];
-			delayed = [];
+			delayed = Array.init all_typer_passes_length (fun _ -> { tasks = []});
+			delayed_min_index = 0;
 			debug_delayed = [];
 			doinline = com.display.dms_inline && not (Common.defined com Define.NoInline);
 			retain_meta = Common.defined com Define.RetainUntypedMeta;