Move partitioning to separate module

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1186 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

1 files changed, 92 insertions, 0 deletions

diff --git a/frontend/partition.icl b/frontend/partition.icl
new file mode 100644
index 0000000..db1c84e
--- /dev/null
+++ b/frontend/partition.icl
@@ -0,0 +1,92 @@
+/*
+	module owner: Diederik van Arkel
+*/
+implementation module partition
+
+import syntax, transform
+
+/*
+ *	PARTITIONING
+ */
+
+::	PartitioningInfo = 
+	{	pi_marks :: 		!.{# Int}
+	,	pi_next_num ::		!Int
+	,	pi_next_group ::	!Int
+	,	pi_groups ::		![[Int]]
+	,	pi_deps ::			![Int]
+	}
+
+NotChecked :== -1	
+
+partitionateFunctions :: !*{# FunDef} ![IndexRange] -> (!*{! Group}, !*{# FunDef})
+partitionateFunctions fun_defs ranges
+	#! max_fun_nr = size fun_defs
+	# partitioning_info = { pi_marks = createArray max_fun_nr NotChecked, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [] }
+	  (fun_defs, {pi_groups,pi_next_group}) = 
+	  		foldSt (partitionate_functions max_fun_nr) ranges (fun_defs, partitioning_info)
+	  groups = { {group_members = group} \\ group <- reverse pi_groups }
+	= (groups, fun_defs)
+where
+	partitionate_functions :: !Index !IndexRange !(!*{# FunDef}, !*PartitioningInfo) -> (!*{# FunDef}, !*PartitioningInfo)
+	partitionate_functions max_fun_nr ir=:{ir_from,ir_to} (fun_defs, pi=:{pi_marks})
+		| ir_from == ir_to
+			= (fun_defs, pi)
+		| pi_marks.[ir_from] == NotChecked
+			# (_, fun_defs, pi) = partitionate_function ir_from max_fun_nr fun_defs pi
+			= partitionate_functions max_fun_nr { ir & ir_from = inc ir_from } (fun_defs, pi)
+			= partitionate_functions max_fun_nr { ir & ir_from = inc ir_from } (fun_defs, pi)
+
+	partitionate_function :: !Int !Int !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*PartitioningInfo)
+	partitionate_function fun_index max_fun_nr fun_defs pi=:{pi_next_num}
+		# (fd, fun_defs) = fun_defs![fun_index]
+		# {fi_calls} = fd.fun_info
+		  (min_dep, fun_defs, pi) = visit_functions fi_calls max_fun_nr max_fun_nr fun_defs (push_on_dep_stack fun_index pi)
+			with
+				visit_functions :: ![FunCall] !Int !Int !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*PartitioningInfo)
+				visit_functions [FunCall fc_index _:funs] min_dep max_fun_nr fun_defs pi=:{pi_marks} 
+					#! mark = pi_marks.[fc_index]
+					| mark == NotChecked
+						# (mark, fun_defs, pi) = partitionate_function fc_index max_fun_nr fun_defs  pi
+						= visit_functions funs (min min_dep mark) max_fun_nr fun_defs pi
+						= visit_functions funs (min min_dep mark) max_fun_nr fun_defs pi
+				
+				visit_functions [MacroCall module_index fc_index _:funs] min_dep max_fun_nr fun_defs pi
+					= abort ("visit_functions "+++toString fd.fun_symb+++" "+++toString module_index+++" "+++toString fc_index)
+				
+				visit_functions [] min_dep max_fun_nr fun_defs pi
+					= (min_dep, fun_defs, pi)
+		= try_to_close_group fun_index pi_next_num min_dep max_fun_nr fun_defs pi
+
+/*				  
+	partitionate_function :: !Int !Int !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*PartitioningInfo)
+	partitionate_function fun_index max_fun_nr fun_defs pi=:{pi_next_num}
+		#! fd = fun_defs.[fun_index]
+		| fd.fun_kind
+			# {fi_calls} = fd.fun_info
+			  (min_dep, fun_defs, pi) = visit_functions fi_calls max_fun_nr max_fun_nr fun_defs (push_on_dep_stack fun_index pi)
+			= try_to_close_group fun_index pi_next_num min_dep max_fun_nr fun_defs pi
+			= (max_fun_nr, fun_defs, pi)
+*/
+	push_on_dep_stack :: !Int !*PartitioningInfo -> *PartitioningInfo;
+	push_on_dep_stack fun_index pi=:{pi_deps,pi_marks,pi_next_num}
+		= { pi & pi_deps = [fun_index : pi_deps], pi_marks = { pi_marks & [fun_index] = pi_next_num}, pi_next_num = inc pi_next_num}
+
+
+	try_to_close_group :: !Int !Int !Int !Int !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*PartitioningInfo)
+	try_to_close_group fun_index fun_nr min_dep max_fun_nr fun_defs pi=:{pi_marks, pi_deps, pi_groups, pi_next_group}
+		| fun_nr <= min_dep
+			# (pi_deps, pi_marks, group, fun_defs)
+				= close_group fun_index pi_deps pi_marks [] max_fun_nr pi_next_group fun_defs
+			  pi = { pi & pi_deps = pi_deps, pi_marks = pi_marks, pi_next_group = inc pi_next_group,  pi_groups = [group : pi_groups] }
+			= (max_fun_nr, fun_defs, pi)
+			= (min_dep, fun_defs, pi)
+	where
+		close_group :: !Int ![Int] !*{# Int} ![Int] !Int !Int !*{# FunDef} -> (![Int], !*{# Int}, ![Int], !*{# FunDef})
+		close_group fun_index [d:ds] marks group max_fun_nr group_number fun_defs
+			# marks = { marks & [d] = max_fun_nr }
+			# (fd,fun_defs) = fun_defs![d]
+			# fun_defs = { fun_defs & [d] = { fd & fun_info.fi_group_index = group_number }}
+			| d == fun_index
+				= (ds, marks, [d : group], fun_defs)
+				= close_group fun_index ds marks [d : group] max_fun_nr group_number fun_defs