diff options
author | clean | 2000-07-11 12:00:01 +0000 |
---|---|---|
committer | clean | 2000-07-11 12:00:01 +0000 |
commit | a90746865310610a5e7e597a91b34931e0924492 (patch) | |
tree | ac5108b437e12035f1ae50181a576bbcbac2617c | |
parent | Fixed call to changed front end interface (diff) |
fixed bug in 'case_is_partial'
git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@187 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
-rw-r--r-- | frontend/convertcases.icl | 23 |
1 files changed, 21 insertions, 2 deletions
diff --git a/frontend/convertcases.icl b/frontend/convertcases.icl index df84b32..65b9647 100644 --- a/frontend/convertcases.icl +++ b/frontend/convertcases.icl @@ -148,17 +148,35 @@ combineDefaults default_ptr No bound_vars guards group_index common_defs ci=:{ci where case_is_partial (AlgebraicPatterns {glob_module, glob_object} patterns) common_defs # {td_rhs} = common_defs.[glob_module].com_type_defs.[glob_object] - = length patterns < nr_of_alternatives td_rhs + = length patterns < nr_of_alternatives td_rhs || has_partial_pattern patterns where nr_of_alternatives (AlgType conses) = length conses nr_of_alternatives _ = 1 + has_partial_pattern [] + = False + has_partial_pattern [{ap_expr} : patterns] + = is_partial_expression ap_expr || has_partial_pattern patterns case_is_partial (BasicPatterns BT_Bool bool_patterns) common_defs - = length bool_patterns < 2 + = length bool_patterns < 2 || has_partial_basic_pattern bool_patterns + where + has_partial_basic_pattern [] + = False + has_partial_basic_pattern [{bp_expr} : patterns] + = is_partial_expression bp_expr || has_partial_basic_pattern patterns case_is_partial patterns common_defs = True + + is_partial_expression (Case {case_guards,case_default=No}) + = case_is_partial case_guards common_defs + is_partial_expression (Case {case_guards,case_default=Yes case_default}) + = is_partial_expression case_default && case_is_partial case_guards common_defs + is_partial_expression (Let {let_expr}) + = is_partial_expression let_expr + is_partial_expression _ + = False combineDefaults default_ptr this_default bound_vars guards group_index common_defs ci = (this_default, ci) @@ -304,6 +322,7 @@ optionalToListofLists No hasOption (Yes _) = True hasOption No = False +convertPatterns :: CasePatterns [[AType]] (Optional (FreeVar,AType)) [.(FreeVar,AType)] [(FreeVar,AType)] (Ptr ExprInfo) Index {#CommonDefs} *ConversionInfo -> *(!.[BackendBody],!*ConversionInfo); convertPatterns (AlgebraicPatterns algtype patterns) cons_types opt_var left_vars right_vars default_ptr group_index common_defs ci # (guarded_exprs_list, ci) = mapSt (convert_algebraic_guard_into_function_pattern opt_var left_vars right_vars group_index common_defs default_ptr) (zip2 patterns cons_types) ci |