diff options
| -rw-r--r-- | frontend/partition.dcl | 5 | ||||
| -rw-r--r-- | frontend/partition.icl | 92 | ||||
| -rw-r--r-- | frontend/trans.dcl | 4 | ||||
| -rw-r--r-- | frontend/trans.icl | 91 |
4 files changed, 99 insertions, 93 deletions
diff --git a/frontend/partition.dcl b/frontend/partition.dcl new file mode 100644 index 0000000..ddf2222 --- /dev/null +++ b/frontend/partition.dcl @@ -0,0 +1,5 @@ +definition module partition + +import syntax, transform + +partitionateFunctions :: !*{# FunDef} ![IndexRange] -> (!*{! Group}, !*{# FunDef}) 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 diff --git a/frontend/trans.dcl b/frontend/trans.dcl index b962cce..d23c9ff 100644 --- a/frontend/trans.dcl +++ b/frontend/trans.dcl @@ -3,14 +3,12 @@ definition module trans import StdEnv import syntax, transform -import classify +import classify, partition transformGroups :: !CleanupInfo !Int !Int !*{! Group} !*{#FunDef} !*{!.ConsClasses} !{# CommonDefs} !{# {# FunType} } !*ImportedTypes !ImportedConstructors !*TypeDefInfos !*VarHeap !*TypeHeaps !*ExpressionHeap !Bool -> (!*{! Group}, !*{#FunDef}, !*ImportedTypes, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, !*{!ConsClasses}) -partitionateFunctions :: !*{# FunDef} ![IndexRange] -> (!*{! Group}, !*{# FunDef}) - convertSymbolType :: !Bool !{# CommonDefs} !SymbolType !Int !*ImportedTypes !ImportedConstructors !*TypeHeaps !*VarHeap -> (!SymbolType, !*ImportedTypes, !ImportedConstructors, !*TypeHeaps, !*VarHeap) diff --git a/frontend/trans.icl b/frontend/trans.icl index 8f551e7..6d8776b 100644 --- a/frontend/trans.icl +++ b/frontend/trans.icl @@ -6,7 +6,7 @@ implementation module trans import StdEnv import syntax, transform, checksupport, StdCompare, check, utilities, unitype, typesupport, type -import classify +import classify, partition SwitchCaseFusion fuse dont_fuse :== dont_fuse // fuse SwitchGeneratedFusion fuse dont_fuse :== fuse @@ -40,95 +40,6 @@ get_producer_symbol (PR_GeneratedFunction symbol arity _) get_producer_symbol (PR_Constructor symbol arity _) = (symbol,arity) -/* - * 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 -/* -:: BitVector :== Int -*/ - // Extended variable info accessors... readVarInfo :: VarInfoPtr *VarHeap -> (VarInfo, !*VarHeap) |