diff options
| author | johnvg | 2012-08-08 10:36:24 +0000 |
|---|---|---|
| committer | johnvg | 2012-08-08 10:36:24 +0000 |
| commit | b585307ec4ec73b9586e22a3e13caf8ff6a3380b (patch) | |
| tree | 9381983f82c047d0c6a25bb4296987521dea7738 /frontend/classify.icl | |
| parent | use an unboxed tail strict list for cc_linear_bits to reduce memory usage (diff) | |
make field aci_linearity_of_patterns of record ActiveCaseInfo strict
git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@2138 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
Diffstat (limited to 'frontend/classify.icl')
| -rw-r--r-- | frontend/classify.icl | 17 |
1 files changed, 14 insertions, 3 deletions
diff --git a/frontend/classify.icl b/frontend/classify.icl index 2ccb8ec..86e8f68 100644 --- a/frontend/classify.icl +++ b/frontend/classify.icl @@ -1376,14 +1376,14 @@ get_linearity_info cc_linear_bits (AlgebraicPatterns _ algebraic_patterns) var_h get_linearity_info cc_linear_bits (OverloadedListPatterns _ _ algebraic_patterns) var_heap = get_linearity_info_of_patterns cc_linear_bits algebraic_patterns var_heap get_linearity_info cc_linear_bits _ var_heap - = ([], var_heap) + = ([!!], var_heap) get_linearity_info_of_patterns cc_linear_bits algebraic_patterns var_heap - = mapSt (get_linearity_info_of_pattern cc_linear_bits) algebraic_patterns var_heap + = mapStStrictR (get_linearity_info_of_pattern cc_linear_bits) algebraic_patterns var_heap where get_linearity_info_of_pattern cc_linear_bits {ap_vars} var_heap # (var_indices, var_heap) = mapSt get_var_index ap_vars var_heap - = ([if (index==cNope) True (cc_linear_bits!!$index) \\ index<-var_indices], var_heap) + = ([#if (index==cNope) True (cc_linear_bits!!$index) \\ index<-var_indices!], var_heap) get_var_index {fv_info_ptr} var_heap # (vi, var_heap) = readPtr fv_info_ptr var_heap @@ -1397,6 +1397,17 @@ set_linearity_info fun fun_index fun_cons_class fun_ref_counts group_strictness cc_args = add_unused_args fun fun_index fun_cons_class.cc_args fun_ref_counts group_strictness = { fun_cons_class & cc_args = cc_args } +mapStStrictR f l s :== map_st l s +where + map_st [x : xs] s + # (x, s) = f x s + (xs, s) = map_st xs s + #! s = s + = ([!x : xs!], s) + map_st [] s + #! s = s + = ([!!], s) + foldComponentMembersSt op l st :== fold_ComponentMembers_st l st where fold_ComponentMembers_st (ComponentMember a as) st |